usingStatsBase: HistogramusingStatistics: quantileusingPrettyTables: pretty_tableconst BARS =collect("▁▂▃▄▅▆▇█")functionunicode_histogram(data, nbins =12)# @show data f =fit(Histogram, data, nbins = nbins) # nbins: more like a guideline than a rule, really# scale weights between 1 and 8 (length(BARS)) to fit the indices in BARS# eps is needed so indices are in the interval [0, 8) instead of [0, 8] which could# result in indices 0:8 which breaks things scaled = f.weights .* (length(BARS) /maximum(f.weights) -eps()) indices =floor.(Int, scaled) .+1returnjoin((BARS[i] for i in indices))endfunctionprecis(x; digits =4, a =0.11) d =DataFrame() df =isa(x, DataFrame) ? x :DataFrame( x = x ) cols =collect.(skipmissing.(eachcol(df))) d.param =names(df) d.mean =mean.(cols) d.std =std.(cols) quants =quantile.(cols, ([a/2, 0.5, 1-a/2], )) quants =hcat(quants...) d[:, "5.5%"] = quants[1,:] d[:, "50%"] = quants[2,:] d[:, "94.5%"] = quants[3,:] d.histogram =unicode_histogram.(cols, min(size(df, 1), 12))for col in ["mean", "std", "5.5%", "50%", "94.5%"] d[:, col] .=round.(d[:, col], digits = digits)enddisplay(pretty_table(d))end
# code for the normalizing constantfunctionibeta( x , a , b ) # (R => julia)## pbeta(x, a, b) => cdf(Beta(a,b), x)## pbeta(x, a, b, log.p = TRUE) => log(cdf(Beta(a,b), x))## lbeta(a,b) => logbeta(a,b)exp( log(cdf(Beta(a, b), x)) +logbeta(a,b) )endfunctionZ( x, W , L ) ( ibeta( 1-x , L+1, W+1 ) -ibeta( x , L+1, W+1 ) ) / ( 1-2*x )end# dataW =6L =3x_values =0:0.01:1y_values =pdf(Beta(W +1, L +1), x_values)plot(x_values, y_values, linewidth=3, color=:black, label="Beta(7, 4)", xlabel ="proportion of water", ylabel="posterior probability")# new misclassification posteriorxe =0.1# there is no `curve` function so we generate a function and broadcastfunctionmisclass_post( x , xe , W , L ) (1/Z(xe,W,L)) * (x*(1-xe)+(1-x)*xe)^W * ((1-x)*(1-xe)+x*xe)^Lendy_values =misclass_post.(x_values, xe, W, L)plot!(x_values, y_values, linewidth=3, color=:red)
Code 2.23
functionmisclass_post( x , xe , W , L ) (1/Z(xe,W,L)) * (x*(1-xe)+(1-x)*xe)^W * ((1-x)*(1-xe)+x*xe)^Lend# port function `rethinking::grau()`functiongrau(alpha=0.5)# http://juliagraphics.github.io/Colors.jl/stable/constructionandconversion/#Color-Parsingcoloralpha(colorant"black", alpha)endfunctionplot_sim( p , N, xe ) sim_sample =sim_globe2( p , N , xe); W =sum(sim_sample .=="W") L =sum(sim_sample .=="L")# x_values =0:0.01:1 y_values =pdf(Beta(W +1, L +1), x_values)#plot(x_values, y_values, linewidth=2, color=:black)# new misclassification posterior y_values =misclass_post.(x_values, xe, W, L)vline!([0.7], color=grau(), linewidth=1)plot!(x_values, y_values, linewidth=2, color=:red)xlims!(.5, .85) # zoom in to make the subplots cleanerend# repeat the function a few times. observe how the new posterior, ## which accounts for misclassification, is consistently closer to true p.plots = Plots.Plot[plot() for i in1:9];# iterate through the sample one at a time, keeping a vector prior obsp =0.7N =Int(1e3)xe =0.2for i in1:n plots[i] =plot_sim(p,N,xe)if i ==1plot!(xlabel ="proportion of water", ylabel="posterior probability")elseifmod(i-1,3) !=0plot!(yticks = [])endend# Splat (...) `plots` into a single 3x3 grid plot (fig2_7)plot(plots..., layout=(3,3), size = (700,700), plot_title ="Ignores Missclassification (black) vs Accounts (red)", plot_titlefontsize=10)